home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok20 / top / top.mod < prev    next >
Text File  |  1993-11-04  |  21KB  |  645 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    Top
  3.     :Author.     Uwe Meyer
  4.     :Address.    Alex. v. Wacker P.4  5000 Köln 71
  5.     :Phone.      0221/704915
  6.     :Shortcut.   [umk]
  7.     :Version.    1.0
  8.     :Date.       22-Apr-89
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga v3.2d
  12.     :Imports.    IntuiStruct, Nicolas Benezan [bne] 
  13.     :Contents.   Baut ein neues Desktop auf
  14.     :Remark.     Verwaltet zur Zeit max. 200 Files (keine dyn. ARRAY's)
  15.     :Usage.      CLI:Top <keine Optionen> oder WORKBENCH: Icon doppelklicken
  16. ---------------------------------------------------------------------------*)
  17.  
  18. MODULE Top;
  19.  
  20. FROM SYSTEM IMPORT
  21.  ADR, ADDRESS, CAST, LONGSET;
  22.  
  23. FROM Arts IMPORT
  24.  TermProcedure, CurrentLevel, Assert;
  25.  
  26. FROM Conversions IMPORT
  27.  ValToStr;
  28.  
  29. FROM Dos IMPORT
  30.  Lock, UnLock, sharedLock, FileLockPtr, FileHandlePtr,
  31.  FileInfoBlock, FileInfoBlockPtr,
  32.  Examine, DeleteFile, CreateDir, Info, Rename, Execute, Delay,
  33.  Open, Close, Read, Write, oldFile, newFile;
  34.  
  35. FROM Exec IMPORT
  36.  Wait, GetMsg, ReplyMsg;
  37.  
  38. FROM Heap IMPORT
  39.  AllocMem, Deallocate;
  40.  
  41. FROM Intuition IMPORT
  42.  WindowPtr, SetWindowTitles, SizeWindow, GadgetPtr, GadgetFlags,
  43.  IDCMPFlagSet, IDCMPFlags,  ModifyIDCMP, IntuiMessagePtr, DoubleClick,
  44.  WBenchToFront, ScreenToFront, MenuItemPtr, ItemAddress;
  45.  
  46. FROM IntuiStruct IMPORT
  47.  AllocProc, DeallocProc, MenuNull;
  48.  
  49. FROM Str IMPORT
  50.  Length, Concat, Copy;
  51.  
  52. FROM Topadd IMPORT
  53.  MyRequest, reqtext, REQLINES, REQGADS, GetName, CopyFile;
  54.  
  55. FROM Topimg IMPORT
  56.  DefineImages;
  57.  
  58. FROM Topinc IMPORT
  59.  Init, DefineMenus, ReadDir, SubPath, ParentPath,
  60.  MakeGadgets, Cleanup, CountSelected, FindSelected,
  61.  MAXDIR, PATHLEN, NAMELEN, DIR, PROP, XSPACE, YSPACE,
  62.  directory, pathname, entries, path, scr, window, win, act, prop,
  63.  gad, fgad, dgad, device, menustripptr, mylevel;
  64.  
  65.  
  66. VAR    dir        : ARRAY [0..1],[0..MAXDIR] OF directory;
  67.     i        : INTEGER;            (* Zählvariable    *)
  68.     gadact        : INTEGER;            (* Selekt. Gadget  *)
  69.     msg        : IntuiMessagePtr;        (* Intuition -     *)
  70.     msgclass    : IDCMPFlagSet;            (* Message   -     *)
  71.     msgcode        : CARDINAL;            (* System    -     *)
  72.     msgadr        : GadgetPtr;            (* Verwaltung      *)
  73.     waitmask    : LONGSET;            (* WaitMaske       *)
  74.     signal        : LONGSET;            (* WaitSignal      *)
  75.     csec        : LONGCARD;            (* akt Zeit Sek.   *)
  76.     cmic        : LONGCARD;            (* akt Zeit Mik.   *)
  77.     ssec        : LONGCARD;            (* Start Zeit Sek. *)
  78.     smic        : LONGCARD;            (* Start Zeit Mik. *)
  79.     doubclick    : BOOLEAN;            (* Doppelklick ?   *)
  80.     ok        : BOOLEAN;            (* Rückgabewert    *)
  81.     check        : INTEGER;            (* Rückgabewert    *)
  82.     reqt        : ARRAY[0..REQLINES] OF reqtext;(* Requestertexte  *)
  83.     reqg        : ARRAY[0..REQGADS] OF reqtext; (* Reqgadgetstexte *)
  84.     warn        : ARRAY [0..20] OF CHAR;    (* Windowarntext   *)
  85.     
  86.  
  87. PROCEDURE NewDirectory;
  88.  
  89. CONST    OLD        = -1;                (* alter Scrtitel  *)
  90.     NODEV        = -2;                (* ReadDir Fehler  *)
  91.     
  92. BEGIN
  93.  
  94. (*--------------------------------------------------------------------------)
  95. Pfadnamen in Windowtitel setzen, Directory lesen, Prop-Position auf 0 stellen
  96. und Directory in Form von Gadgets ausgeben. Fehlermeldung falls bei ReadDir
  97. Pfadname nicht gefunden wurde
  98. (--------------------------------------------------------------------------*)
  99.  
  100.  SetWindowTitles (win[act], ADR ("WARTE! Lese Verzeichnis.."), OLD);
  101.  entries[act] := ReadDir (dir[act], path[act]);
  102.  prop[act].vertPot := 0;
  103.  IF entries[act] = NODEV THEN
  104.   entries[act] := -1;
  105.   warn := "Lesefehler auf ";
  106.   Concat (warn, path[act]);
  107.   SetWindowTitles (win[act], ADR (warn), OLD);
  108.  ELSE
  109.   MakeGadgets (act, dir[act], entries[act]);
  110.   SetWindowTitles (win[act], ADR (path[act]), OLD);
  111.  END;
  112. END NewDirectory;
  113.  
  114.  
  115. PROCEDURE ExecMenu (msgcode : CARDINAL) : BOOLEAN;
  116.  
  117. CONST    DIR        = 2;
  118.     OLD        = -1;    
  119.  
  120. VAR    menunr        : INTEGER;            (* Nummer Menu     *)
  121.     itemnr        : INTEGER;            (* Nummer Item     *)
  122.     mitem        : MenuItemPtr;
  123.     reqtmax        : INTEGER;            (* größte Reqtxtnr *)
  124.     src, des, hlp    : ARRAY[0..30] OF CHAR;        (* Source, Dest    *)
  125.     filelockptr    : FileLockPtr;
  126.     fileblockptr    : FileInfoBlockPtr;
  127.     prot        : LONGINT;            (* ProtBits        *)
  128.         i        : INTEGER;            (* Zähler          *)
  129.     j        : INTEGER;            (* Zähler          *)
  130.         
  131. BEGIN
  132. (*--------------------------------------------------------------------------)
  133. Das gewählte Menu inklusive Item aus der Message heraussuchen
  134. (--------------------------------------------------------------------------*)
  135.  
  136.  WHILE msgcode # MenuNull DO
  137.   mitem := ItemAddress (menustripptr, msgcode);
  138.   menunr := msgcode REM 32;
  139.   itemnr := msgcode / 32 REM 64;
  140.   msgcode := mitem^.nextSelect;
  141.  END;
  142.  IF menunr = 0 THEN
  143.   IF itemnr = 0 THEN
  144.  
  145. (*--------------------------------------------------------------------------)
  146. Es wurde ABOUT angewählt
  147. (--------------------------------------------------------------------------*)
  148.  
  149.    reqt[0] := "T O P   Version 1.0";
  150.    reqt[1] := "   von Uwe Meyer";
  151.    reqt[2] := " ";
  152.    reqt[3] := "   Mitglied  der ";
  153.    reqt[4] := "  Soft-Ware-Army";
  154.    reqg[0] := "  PD";
  155.    reqg[1] := "  PD";
  156.    check := MyRequest (scr, ADR ("Programm-Info"), 4, reqt, 50, 1, reqg);
  157.   ELSE
  158.  
  159. (*--------------------------------------------------------------------------)
  160. QUIT bringt eine MyRequest Nachricht, ExecMenu gibt daraufhin FALSE zurück
  161. (--------------------------------------------------------------------------*)
  162.  
  163.    reqt[0] := "Wirklich Schluß ?";                (* Quit    *)
  164.    reqg[0] := " Ja";
  165.    reqg[1] := "Nein";
  166.    check := MyRequest (scr, ADR ("Quit-Request"), 0, reqt, 40, 1, reqg);
  167.    IF check = 0 THEN
  168.     RETURN (FALSE);
  169.    END;
  170.   END;
  171.  ELSIF menunr = 1 THEN
  172.   i := CountSelected (fgad[act]);
  173.  
  174. (*--------------------------------------------------------------------------)
  175. DateiInfo ausgeben (mindestens 1 ausgewählt), Speicher für FileInfo anfordern
  176. (--------------------------------------------------------------------------*)
  177.  
  178.   IF (itemnr = 0) AND (i # 0) THEN                (* Info    *)
  179.    AllocMem (fileblockptr, SIZE (FileInfoBlock), FALSE);
  180.    i := -1;
  181.    REPEAT
  182.     INC (i);
  183.     i := FindSelected (i, fgad[act]);
  184.     IF (i # -1) THEN
  185.      Copy (src, path[act]);
  186.      SubPath (src, dir[act, i].name);
  187.  
  188. (*--------------------------------------------------------------------------)
  189. FileInfoBlockPtr mit Lock und Examine laden
  190. (--------------------------------------------------------------------------*)
  191.  
  192.      filelockptr := Lock (ADR (src), sharedLock);
  193.      ok := Examine (filelockptr, fileblockptr);
  194.      reqt[0] := "Name     : ";
  195.      Concat (reqt[0], dir[act, i].name);
  196.      reqt[1] := "Typ      : ";
  197.  
  198. (*--------------------------------------------------------------------------)
  199. Falls Datei ein SubDir ist nur Dateinamen und ProtectionBits ausgeben
  200. (--------------------------------------------------------------------------*)
  201.  
  202.      IF dir[act, i].type = DIR THEN
  203.       Concat (reqt[1], "DIR");
  204.       reqtmax := 2;
  205.      ELSE
  206.       Concat (reqt[1], "DATEI");
  207.       reqtmax := 4;
  208.      END;
  209.  
  210. (*--------------------------------------------------------------------------)
  211. Auswertung der Protection Bit Maske
  212. (--------------------------------------------------------------------------*)
  213.  
  214.      reqt[2] := "ProtBits : ";
  215.      src := "DEWRASPH";
  216.      prot := CAST (LONGINT, fileblockptr^.protection);
  217.      FOR j := 0 TO 3 DO                    (* Bits 0..3       *)
  218.       IF prot MOD 2 # 0 THEN                (* sind aktiv = 1  *)
  219.        src[j] := "-";
  220.       END;
  221.      prot := prot DIV 2;
  222.      END;
  223.      FOR j := 4 TO 7 DO                    (* Bits 4..7       *)
  224.       IF prot MOD 2 = 0 THEN                (* sind aktiv = 0  *)
  225.        src[j] := "-";
  226.       END;
  227.      prot := prot DIV 2;
  228.      END;
  229.      Concat (reqt[2], src); 
  230.  
  231. (*--------------------------------------------------------------------------)
  232. Byte und Blocklänge in Requestertext eintragen und Requester aufrufen
  233. (--------------------------------------------------------------------------*)
  234.  
  235.      reqt[3] := "Bytes    : ";
  236.      ValToStr (fileblockptr^.size, FALSE, src, 10, 6, " ", ok);
  237.      Concat (reqt[3], src);
  238.      reqt[4] := "Blöcke   : ";
  239.      ValToStr (fileblockptr^.numBlocks, FALSE, src, 10, 6, " ", ok);
  240.      Concat (reqt[4], src);
  241.      reqg[0] := "Weiter";
  242.      reqg[1] := " Stop";
  243.      check := MyRequest (scr, ADR ("Info-Request"), reqtmax, reqt, 54,
  244.                          1, reqg);
  245.      IF check = 1 THEN
  246.       i := -1;
  247.      END;
  248.      UnLock (filelockptr);
  249.     END;
  250.    UNTIL i = -1;
  251.    Deallocate (fileblockptr);
  252.  
  253. (*--------------------------------------------------------------------------)
  254. Makedir verändert den Fenstertitel, holt sich per Stringgadget einen neuen
  255. Namen (ÜbergabeString scr = "") und erzeugt mit CreateDir ein neues SubDir
  256. (--------------------------------------------------------------------------*)
  257.  
  258.   ELSIF itemnr = 1 THEN                        (* MakeDir *)
  259.    src[0] := CHAR (0);
  260.    SetWindowTitles (win[act], ADR ("Tippe neuen Dirnamen ein!"), OLD);
  261.    GetName (win[act], src);
  262.    Copy (des, path[act]);
  263.    SubPath (des, src);
  264.    filelockptr := CreateDir (ADR (des));
  265.    UnLock (filelockptr);
  266.    NewDirectory;
  267.  
  268. (*--------------------------------------------------------------------------)
  269. Rename arbeitet ähnlich MakeDir, nur wird der alte Name an GetName übergeben
  270. (--------------------------------------------------------------------------*)
  271.  
  272.   ELSIF (itemnr = 2) AND (i # 0) THEN                (* Rename  *)
  273.    i := -1;
  274.    REPEAT
  275.     INC (i);
  276.     i := FindSelected (i, fgad[act]);
  277.     IF (i # -1) THEN
  278.      SetWindowTitles (win[act], ADR ("Tippe den neuen Namen ein!"), OLD);
  279.      Copy (hlp, dir[act, i].name);
  280.      GetName (win[act], hlp);
  281.      Copy (src, path[act]);
  282.      SubPath (src, dir[act, i].name);
  283.      Copy (des, path[act]);
  284.      SubPath (des, hlp);
  285.      ok := Rename (ADR (src), ADR (des));
  286.      IF ok THEN
  287.       Copy (dir[act, i].name, hlp);
  288.      END;
  289.     END;
  290.    UNTIL i = -1;
  291.    MakeGadgets (act, dir[act], entries[act]);
  292.  
  293. (*--------------------------------------------------------------------------)
  294. Copy benutzt eine eigene Kopierroutine aus Topadd und kopiert alle ange-
  295. wählten Dateien. Nur das Ziellaufwerk wird mit NewDirectory aufgerufen
  296. (--------------------------------------------------------------------------*)
  297.  
  298.   ELSIF (itemnr = 3) AND (i # 0) THEN                (* Copy    *)
  299.    reqt[0] := "Kopiere ";
  300.    ValToStr (i, FALSE, src, 10, 3, " ", ok);
  301.    Concat (reqt[0], src);
  302.    Concat (reqt[0], " Datei(en)");
  303.    reqt[1] := "VON  ";
  304.    Concat (reqt[1], path[act]);
  305.    reqt[2] := "NACH ";
  306.    Concat (reqt[2], path[1 - act]);
  307.    reqg[0] := " Ja";
  308.    reqg[1] := "Nein";
  309.    check := MyRequest (scr, ADR ("Kopier-Request"), 2, reqt, 40, 1, reqg);
  310.    IF check = 0 THEN
  311.     i := -1;
  312.     REPEAT
  313.      INC (i);
  314.      i := FindSelected (i, fgad[act]);
  315.      IF (i # -1) AND (dir[act, i].type # DIR) THEN
  316.       warn := "Kopiere ";
  317.       Concat (warn, dir[act, i].name);
  318.       SetWindowTitles (win[act], ADR (warn), OLD);
  319.       Copy (src, path[act]);
  320.       Copy (des, path[1 - act]);
  321.       SubPath (src, dir[act, i].name);
  322.       SubPath (des, dir[act, i].name);
  323.       IF NOT CopyFile (src, des) THEN
  324.        warn := "Kopierfehler bei ";
  325.        Concat (warn, src);
  326.        SetWindowTitles (win[act], ADR (warn), OLD);
  327.        Delay (100);
  328.        i := -1;
  329.       END;
  330.      END;
  331.     UNTIL i = -1;
  332.     SetWindowTitles (win[act], ADR (path[act]), OLD);
  333.     act := 1 - act;
  334.     NewDirectory;
  335.     act := 1 - act;
  336.    END;
  337.   ELSIF (itemnr = 4) AND (i # 0) THEN
  338.  
  339. (*--------------------------------------------------------------------------)
  340. Delete löscht Files; aber nur leere Directories
  341. (--------------------------------------------------------------------------*)
  342.  
  343.    reqt[0] := "Lösche ";                    (* Delete  *)
  344.    ValToStr (i, FALSE, src, 10, 3, " ", ok);
  345.    Concat (reqt[0], src);
  346.    Concat (reqt[0], " Datei(en)");
  347.    reqt[1] := "VON ";
  348.    Concat (reqt[1], path[act]);
  349.    reqg[0] := " Ja";
  350.    reqg[1] := "Nein";
  351.    check := MyRequest (scr, ADR ("Lösch-Request"), 1, reqt, 40, 1, reqg);
  352.    IF check = 0 THEN
  353.     i := -1;
  354.     REPEAT
  355.      INC (i);
  356.      i := FindSelected (i, fgad[act]);
  357.      IF i # -1 THEN
  358.       warn := "Lösche ";
  359.       Concat (warn, dir[act, i].name);
  360.       SetWindowTitles (win[act], ADR (warn), OLD);
  361.       Copy (src, path[act]);
  362.       SubPath (src, dir[act, i].name);
  363.       IF NOT DeleteFile (ADR (src)) THEN
  364.        warn := "Löschfehler bei ";
  365.        Concat (warn, src);
  366.        SetWindowTitles (win[act], ADR (warn), OLD);
  367.       END;
  368.      END;
  369.     UNTIL i = -1;
  370.     NewDirectory;
  371.    END;
  372.   END;
  373.  END;
  374.  RETURN (TRUE);
  375. END ExecMenu;
  376.  
  377.  
  378. PROCEDURE KlickItem;
  379.  
  380. VAR    port1[0BFE001H] : SET OF(s0,s1,s2,s3,s4,s5,lmb);(* linke Maustaste *)
  381.     fh        : FileHandlePtr;        (* Datei Handle    *)
  382.     par        : FileHandlePtr;        (* PRT: Handle     *)
  383.     con        : FileHandlePtr;        (* CON-Win. Handle *)
  384.     title        : ARRAY [0..PATHLEN] OF CHAR;    (* CON-Win. Titel  *)
  385.     count        : LONGINT;            (* bearbeit. Bytes *)
  386.     buf        : ARRAY [0..80] OF CHAR;    (* Filepuffer       *)
  387.     sel        : INTEGER;            (* selekt. Gadgets *)
  388.     exename        : ARRAY [0..200] OF CHAR;    (* Startname&Parms *)
  389.     ok        : BOOLEAN;            (* Status Flag     *)
  390.     
  391. BEGIN
  392. (*--------------------------------------------------------------------------)
  393. Start- und aktuelle Messagezeiten auf Doppelklick testen. Zeiten tauschen
  394. (--------------------------------------------------------------------------*)
  395.  
  396.  doubclick := DoubleClick (ssec, smic, csec, cmic);
  397.  ssec := csec;
  398.  smic := cmic;
  399.  
  400. (*--------------------------------------------------------------------------)
  401. Handelte es sich um einen Doppelklick? Bei DIR's Pfad ändern und lesen
  402. (--------------------------------------------------------------------------*)
  403.  
  404.  IF doubclick THEN
  405.   SubPath (path[act], dir[act, gadact].name);
  406.   IF (dir[act,gadact].type = DIR) THEN
  407.    NewDirectory;
  408.   ELSE
  409.  
  410. (*--------------------------------------------------------------------------)
  411. Für alle anderen Dateien eigenes CON-Fenster zur Ausgabe eröffnen
  412. (--------------------------------------------------------------------------*)
  413.  
  414.    title := "CON:0/11/640/245/";
  415.    Concat (title, path[act]);
  416.    con := Open (ADR (title), oldFile);
  417.  
  418. (*--------------------------------------------------------------------------)
  419. Vier Bytes der Datei lesen und auf Ausführbarkeit prüfen (00 00 03 F3);
  420. (--------------------------------------------------------------------------*)
  421.  
  422.    fh := Open (ADR (path[act]), oldFile);
  423.    IF fh # NIL THEN
  424.     count := Read (fh, ADR (buf[0]), 4);
  425.     Close (fh);
  426.     IF (buf[0] = CHAR (0)) AND (buf[1] = CHAR (0))
  427.         AND (buf[2] = CHAR(3)) AND (buf[3] = CHAR (243)) THEN
  428.  
  429. (*--------------------------------------------------------------------------)
  430. Parameter für ausführbare Datei aus anderem Fenster holen und EXECUTE'n
  431. (--------------------------------------------------------------------------*)
  432.  
  433.      Copy (exename, path[act]);
  434.      IF  CountSelected (fgad[1 - act]) = 1 THEN;
  435.       act := 1 - act;
  436.       sel := 0;
  437.       sel := FindSelected (0, fgad[act]);
  438.       Concat (exename, " ");
  439.       Concat (exename, path[act]);
  440.       IF path[act, Length (path[act]) - 1] # ":" THEN
  441.        Concat (exename, "/");
  442.       END;
  443.       Concat (exename, dir[act, sel].name); 
  444.       act := 1 - act;
  445.      END;
  446.      ok := WBenchToFront ();
  447.      check := Execute (ADR (exename), NIL, con);
  448.     ELSE
  449.  
  450. (*--------------------------------------------------------------------------)
  451. Nicht ausführbare Datei auf Monitor oder Drucker ausgeben
  452. (Bis durch Druck auf die linke Maustaste abgebrochen wird)
  453. (--------------------------------------------------------------------------*)
  454.  
  455.      reqt[0] := "    Ausgabe der Datei";
  456.      reqt[1] := "auf welches Ausgabegerät?";
  457.      reqg[0] := "Monitor";
  458.      reqg[1] := "Drucker";
  459.      reqg[2] := "Abbruch";
  460.      check := MyRequest (scr, ADR ("Ausgabe-Request"), 1, reqt, 62, 2, reqg);
  461.      IF check # 2 THEN
  462.       fh := Open (ADR (path[act]), oldFile);
  463.       IF fh # NIL THEN
  464.        IF check = 1 THEN
  465.         par := Open (ADR ("PRT:"), newFile);
  466.        END;
  467.        ok := WBenchToFront ();
  468.        REPEAT
  469.         count := Read (fh, ADR (buf[0]), 80);
  470.         count := Write (con, ADR (buf[0]), count);
  471.         IF check = 1 THEN
  472.          count := Write (par, ADR (buf[0]), count);
  473.         END;      
  474.        UNTIL (NOT (lmb IN port1)) OR (count # 80);
  475.        IF check = 1 THEN
  476.         buf[0] := CHAR (13);
  477.         count := Write (par, ADR (buf[0]), 1);
  478.         Close (par);
  479.        END;     
  480.        Close (fh);
  481.       END;
  482.      END;
  483.     END;
  484.    END;
  485.  
  486. (*--------------------------------------------------------------------------)
  487. Pfad zurücksetzen, Gadgets erneuern und auf linke Maustaste warten
  488. (--------------------------------------------------------------------------*)
  489.  
  490.    ParentPath (path[act]);
  491.    MakeGadgets (act, dir[act], entries[act]);
  492.    WHILE lmb IN port1 DO
  493.     Delay (5);
  494.    END;
  495.    ScreenToFront (scr);
  496.    Close (con);
  497.   END;
  498.  END;
  499. END KlickItem;
  500.  
  501.  
  502. PROCEDURE SizeIt;
  503.  
  504. CONST    TITLESPACE    = 15;                (* Höhe Tit.leiste *)
  505.     WINSPACE    = 18;                (* Höhe Win.rahmen *)
  506.     INFOSPACE    = 13;                (* Höhe Infozeile  *)
  507.     PROPWIDTH    = 16;                (* Propgad.breite  *)
  508.     
  509. VAR    width        : INTEGER;            (* Neue Win.breite *)
  510.     height        : INTEGER;            (* Neue Win.höhe   *)
  511.     idcmp        : IDCMPFlagSet;            (* IDCMP Retter    *)
  512.     
  513. BEGIN
  514. (*--------------------------------------------------------------------------)
  515. Da SizeWindow eine Message schickt, wird der IDCMP ausgeschaltet
  516. (--------------------------------------------------------------------------*)
  517.  
  518.  idcmp := win[i]^.idcmpFlags;
  519.  ModifyIDCMP (win[i], IDCMPFlagSet {});
  520.  
  521. (*--------------------------------------------------------------------------)
  522. Überprüfung der neuen und alten Window- und Screengrößen
  523. (--------------------------------------------------------------------------*)
  524.  
  525.  width := ((win[i]^.width - PROPWIDTH) / XSPACE) * XSPACE + PROPWIDTH;
  526.  height := ((win[i]^.height - TITLESPACE) / YSPACE) * YSPACE
  527.            + TITLESPACE + INFOSPACE;
  528.  IF width > scr^.width - win[i]^.leftEdge THEN
  529.   width := scr^.width - win[i]^.leftEdge;
  530.  END;
  531.  IF height > scr^.height - win[i]^.topEdge THEN
  532.  height := scr^.height - win[i]^.topEdge;
  533.  END;
  534.  IF width < XSPACE + PROPWIDTH THEN
  535.   width := XSPACE + PROPWIDTH;
  536.  END;
  537.  IF height < YSPACE + TITLESPACE THEN
  538.   height := YSPACE + TITLESPACE + INFOSPACE;
  539.  END;
  540.  SizeWindow (win[i], width - win[i]^.width, height - win[i]^.height);
  541.  Delay (10);
  542.  gad[i].height := height - WINSPACE;
  543.  prop[act].vertPot := 0;
  544.  MakeGadgets (i, dir[i], entries[i]);
  545.  ModifyIDCMP (win[i], idcmp);
  546. END SizeIt;
  547.  
  548.  
  549. PROCEDURE ChangeDevice;
  550.  
  551. CONST    OLD        = -1;
  552.  
  553. BEGIN
  554. (*--------------------------------------------------------------------------)
  555. War es Doppelklick? Wenn ja wird das Directory des neuen Devices sofort
  556. eingelesen, sonst wird nur der Windowtitle neu gesetzt
  557. (--------------------------------------------------------------------------*)
  558.  
  559.  msgadr := msg^.iAddress;
  560.  gadact := msgadr^.gadgetID;
  561.  Delay (10);
  562.  msg := GetMsg (window^.userPort);
  563.  msgclass := msg^.class;
  564.  Copy (path[act], device[gadact]);
  565.  IF msg # NIL THEN
  566.   msgadr := msg^.iAddress;
  567.   gadact := msgadr^.gadgetID;
  568.   ReplyMsg (msg);
  569.   NewDirectory;
  570.  ELSE
  571.   SetWindowTitles (win[act], ADR (path[act]), OLD);
  572.  END;
  573. END ChangeDevice;
  574.  
  575.  
  576. (*** Hauptprogramm ***)
  577.  
  578. BEGIN
  579.  mylevel := CurrentLevel ();
  580.  TermProcedure (Cleanup);
  581.  
  582. (*--------------------------------------------------------------------------)
  583. Speicherreservierungsprozeduren für Intuistruct angeben
  584. (--------------------------------------------------------------------------*)
  585.  
  586.  AllocProc := AllocMem;
  587.  DeallocProc := Deallocate;
  588.  
  589. (*--------------------------------------------------------------------------)
  590. Image und Menustrukturen aufbauen; 
  591. Screen, Fenster und sonstige Startwerte vorbereiten
  592. (--------------------------------------------------------------------------*)
  593.  
  594.  DefineImages;
  595.  DefineMenus;
  596.  Init;
  597.  
  598. (*--------------------------------------------------------------------------)
  599. Auf Message von einem der 3 Fenster warten
  600. (--------------------------------------------------------------------------*)
  601.  
  602.  LOOP
  603.   waitmask := LONGSET {window^.userPort^.sigBit};
  604.   waitmask := waitmask + LONGSET {win[0]^.userPort^.sigBit};
  605.   waitmask := waitmask + LONGSET {win[1]^.userPort^.sigBit};
  606.   signal := Wait (waitmask);
  607.   msg := GetMsg (window^.userPort);
  608.   IF msg # NIL THEN 
  609.    ReplyMsg (msg);
  610.    ChangeDevice;
  611.   END;
  612.   FOR i := 0 TO 1 DO
  613.    msg := GetMsg (win[i]^.userPort);
  614.    WHILE msg # NIL DO
  615.     msgclass := msg^.class;
  616.     csec := msg^.seconds;
  617.     cmic := msg^.micros;
  618.     ReplyMsg (msg);
  619.     IF activeWindow IN msgclass THEN
  620.      act := i;
  621.     ELSIF closeWindow IN msgclass THEN
  622.      ParentPath (path[act]);
  623.      NewDirectory;
  624.     ELSIF gadgetUp IN msgclass THEN
  625.      msgadr := msg^.iAddress;
  626.      gadact := msgadr^.gadgetID;
  627.      IF gadact = PROP THEN
  628.       MakeGadgets (act, dir[act], entries[act]);
  629.      ELSE
  630.       KlickItem;
  631.      END;
  632.     ELSIF newSize IN msgclass THEN
  633.      SizeIt;
  634.     ELSIF menuPick IN msgclass THEN
  635.      msgcode := msg^.code;
  636.      IF NOT ExecMenu (msgcode) THEN
  637.       EXIT;
  638.      END;
  639.     END;
  640.     msg := GetMsg (win[i]^.userPort);
  641.    END;
  642.   END;
  643.  END;
  644. END Top.
  645.